00100	TITLE XM
00200		;↓↓AC DEF
00300	A←1
00400	B←2
00500	C←3
00600	D←4
00700	E←5
00800	L←6
00900	U←7
01000	X←11
01100	Y←12
01200	XD←13
01300	T←15
01400	TT←16
01500	P←17
01600		
01700	LPDL←←69
01800	NBUFS←←4
01900	DSK←←1
02000	XGP←←2
02100	
02200	LMAR←←=0
02300	RMAR←←=1699
02400	WIDTH←←=1700
02500	LBUFL←←=48	;LINE LENGTH IN WORDS
02600	
02700	LSTBIT←←1⊗34
02800	
02900	OVERLAP←←=50
03000	
03100	DOFF←←-=760
03200	
03300	EXTERN JOBREL,JOBFF,JOBTPC,JOBAPR,JOBCNI
03400	MAILBF:	BLOCK 40
03500	SIGN:	0
03600	LINE:	0
03700	PNTR:	0
03800	
     

00100	BEG:	SETOM LINE
00200		GETLIN LINE		;FOR ERROR PRINTOUT
00300		CALLI
00400		HRRZS LINE		;CLEAR LINE BITS
00500		HRRZI A,CORUP
00600		HRRZM A,JOBAPR
00700		SETOM SSS#
00800		HRRZ A,JOBFF		;RESET CORE WITHOUT A RESET
00900		CORE A,
01000		JRST 4,.
01100	
01200	;FLUSHED BY REG  1-3-76
01300	;	MOVE A,[IPC:20000 ↔ 0]
01400	;	INTENB A,
01500	;
01600	;ADDED BY REG:
01700		MOVEI	A,20000		;REG  MPV
01800		APRENB	A,		;REG  ENABLE OLD WAY!
01900	
02000		MOVE P,[-LPDL,,PDL-1]
02100	;Z	OUTSTR [ASCIZ /OLD? /]
02200		SETZM BIGBOT#
02300		SETZM GO#
02400				;NEXT LINE REPLACES FOLLOWING ;Z SECTION.
02500		JRST FILIN	;******* NO 'OLD' FEATURE IN THIS VERSION. ******
02600	
02700	;Z	INCHWL E
02800	;Z	CAIE E,"B"		; B FOR BIG BOTTOM MARGIN (200=1")
02900	;Z	CAIN E,"b"
03000	;Z	CAIA
03100	;Z	JRST .+3
03200	;Z	SETOM BIGBOT
03300	;Z	JRST GOGO-1
03400	;Z	CAIE E,"L"		; L FOR LEGAL SIZE
03500	;Z	CAIN E,"l"
03600	;Z	JRST LEGLEG
03700	;Z	CAIE E,"G"		;IF 'G' SKIP ALL PROMPTS
03800	;Z	CAIN E,"g"
03900	;Z	CAIA
04000	;Z	JRST PASS
04100	;Z	PUSHJ P,FRD		;GO GET DEFAULT FILE NAME.
04200	GONEW:	PUSHJ P,FRD		;GO GET DEFAULT FILE NAME.
04300	GOGO:	MOVEI =11		;DEFAULT PAGE LENGTH = 11" WITH 'G'
04400		JRST GOGOGO
04500	LEGLEG:	PUSHJ P,FRD
04600	LEGAL:	MOVEI =14		;TYPE 'L' FOR LEGAL SIZE 14"
04700	GOGOGO:	MOVEM GO
04800	;;;	SETOM GO		;FOR SKIPING ALL PROMPTS
04900	;	INCHWL E
05000	;	INCHWL E		 GET THE CRLF
05100		CLRBFI			;INSTEAD OF ↑↑
05200	OUTSTR [ASCIZ/USING DEFAULT VALUES.
05300	/]
05400		SETZM ROFLG#
05500		HRREI B,-60	;??
05600		JRST PASS2
05700	;ZPASS:	CAIE E,"Y"
05800	;Z	CAIN E,"y"
05900	;Z	JRST INBITS
06000	;Z	CLRBFI
06100		SETZM SPREAD#
06200	FILIN:	OUTSTR [ASCIZ /FILE? (DEFAULT=PLT.PLT) /]
06300		PUSHJ P,FRD
06400		SKIPE GO
06500		JRST GONEW	;IF 'G' IS NAME THEN USE DEFAULT VALUES.
06600		SETZ A,
06700	YAGN1:	HRREI B,-60
06800		SETZM ROFLG
06900	OUTSTR [ASCIZ/ROTATE? /]		;YOU CAN TYPE 'G' FOR GO HERE TOO.
07000		INCHWL E
07100		CAIE E,"Y"
07200		CAIN E,"y"
07300		SETOM ROFLG
07400		CAIE E,"G"
07500		CAIN E,"g"
07600		JRST GOGO
07700		CAIE E,"L"
07800		CAIN E,"l"
07900		JRST LEGAL
08000		CLRBFI
08100	OUTSTR [ASCIZ/ORIGIN X RIGHT OFFSET RIGHT (DEFAULT=4(CENTER))? /]
08200		PUSHJ P,RNUM
08300		JRST [	PASS2:	HRREI A,-=760 
08400				JRST YDEF]	;GET Y INFO
08500		IMULI A,=100
08600		CAIN C,"."		;DECIMAL POINT?
08700		JRST [	INCHWL C
08800			CAIN C,15
08900			INCHWL C
09000			CAIL C,"0"
09100			CAILE C,"9"
09200			JRST .+1
09300			SUBI C,60
09400			IMULI C,=10
09500			SKIPE SIGN
09600			MOVN C,C
09700			ADD A,C
09800			PUSH P,A
09900			PUSHJ P,RNUM
10000			JFCL
10100			POP P,A
10200			JRST .+1]	;.+1??
10300		MOVN A,A
10400		LSH A,1			;*2 (MAKE IT STEPS)
10500	YDEFP:	CAIE C,12
10600		JRST [	CLRBFI
10700			JRST YAGN1]
10800	YDEF:	ADD A,B
10900		MOVNM A,INIX#
11000	AGAIN:	MOVE A,[FILNAM,,LKENT]
11100		BLT A,LKENT+3
11200		OPEN DSK,[14↔'DSK   '↔IBUF]
11300		JRST 4,.
11400		INBUF DSK,NBUFS
11500		LOOKUP DSK,LKENT
11600		JRST FNF
11700	ASKLEN:	SETZM POOBX#
11800		SETZM POOBY#
11900		PUSHJ P,XINI		;GET X INFO
12000	;	JRST CORLUZ
12100		SETZM XX#
12200		SETZM YY#
12300		MOVEI C,3
12400		HRRZM C,PENN#
12500	OUTER:	IN DSK,
12600		JRST PLOT
12700		STATO DSK,20000
12800		JRST 4,.
12900		RELEAS DSK,
13000	IFN LSTBIT-1,<PUSHJ P,XFIX>
13100		JRST PCUT
13200	
     

00100	XINI:	SKIPN GO
00200		OUTSTR [ASCIZ /LENGTH IN INCHES (Y DIMENSION, DEFAULT=11)? /]
00300		SETZM DEFA#
00400		SKIPE GO
00500		JRST PASSD
00600		PUSHJ P,RNUM
00700		SETOM DEFA		;ASSUME 11 INCHES
00800		JUMPLE A,[XINLER:CLRBFI
00900			JRST XINI]
01000		SKIPGE DEFA		;? GO?
01100	PASSD:	HRRZI A,=11
01200		SKIPE GO
01300		MOVE A,GO
01400	;;PASSD:	MOVE A,GO		;EITHER 11 OR 14
01500		CAIE C,12
01600		JRST XINLER
01700		IMULI A,=200
01800		PUSH P,A
01900	YINI1:	SKIPE GO
02000		JRST PASS3
02100		SKIPL ROFLG
02200		OUTSTR [ASCIZ \ORIGIN Y BOTTOM OFFSET, 200/IN.(DEFAULT=75)? \]
02300		SKIPGE ROFLG
02400		OUTSTR [ASCIZ \ORIGIN Y BOTTOM OFFSET, 200/IN.(DEFAULT=1000)? \]
02500		PUSHJ P,RNUM
02600	PASS3:	JRST [	MOVEI A,=75
02700			SKIPE BIGBOT	;BIGBOT=NEG=200 BOTTOM MARGIN
02800			MOVEI A,=200
02900			SKIPGE ROFLG
03000			MOVEI A,=1000
03100			JRST IYDEF]
03200		CAIE C,12
03300		JRST [	CLRBFI
03400			JRST YINI1]
03500	IYDEF:	IMULI A,LBUFL+1
03600		MOVEM A,IYPOS#
03700		POP P,A
03800	XDEF:	MOVEM A,LINCNT#
03900		MOVEI B,-1(A)
04000		IMULI A,LBUFL+1		;A← BUFSIZ ← ROWS * COL
04100		MOVE T,JOBFF		;GET START ADDR
04200		MOVEM T,XGPPTR
04300		SOS XGPPTR
04400		MOVEI T,2(A)
04500		MOVNI TT,(T)
04600		ADD T,XGPPTR
04700		HRLM TT,XGPPTR		;XGPPTR← -WDCNT,,ADDR-1
04800		MOVE TT,T
04900	
05000		HRRZ L,XGPPTR
05100		MOVSI T,1(L)
05200		HRRI T,2(L)
05300	 	SETZM 1(L)
05400	 	MOVE U,JOBREL
05500	 	BLT T,(U)		;ZERO TO END OF CORE
05600		HRRZI U,(TT)
05700		MOVEM B,SVBBB#
05800		
05900		MOVE Y,IYPOS
06000		ADDI Y,2(L)
06100		MOVEI XD,DBUF+1
06200		SKIPL A,INIX		;WHERE DO WE START
06300		JRST MAYBON
06400		SUBI A,43
06500		IDIV A,[-44]
06600		HRLOI X,XD
06700		SOJA A,SETB
06800	
06900	MAYBON:	ADDI A,43
07000		IDIVI A,44
07100		CAILE A,LBUFL
07200		JRST OFFRT
07300		MOVE X,A
07400		SETZ A,
07500		HRLI X,Y
07600		JRST SETB
07700	
07800	OFFRT:	MOVE X,[XD,,LBUFL]
07900		SUBI A,LBUFL
08000	SETB:	MOVE B,INIX
08100		IDIVI B,44
08200		MOVSI B,400000
08300		MOVN C,C
08400		ROT B,(C)
08500		POPJ P,
08600	
08700	POPJ1:	AOS (P)
08800	CPOPJ:	POPJ P,
08900	
     

00100		MOVE A,E	;ROTATION
00200	ROTA:	MOVE 14,2(A)
00300		LSHC 14,-10
00400		HLLZ C,15
00500		LSHC 14,-16
00600		HLLZ D,15
00700		LSHC 14,-16
00800		EXCH 15,D
00900		LSHC 14,16
01000		ASH D,-26
01100		MOVN 15,D
01200		LSH 15,26
01300		LSHC 14,16
01400		HLLZ 15,C
01500		LSHC 14,10
01600		MOVEM 14,2(A)
01700		AOBJN A,ROTA
01800		JRST PLOT1
01900	
02000	PLOT:	HRR C,IBUF+1
02100		MOVN E,1(C)	;FIX FOR NO WDCNT
02200		MOVSI E,(E)
02300		HRR E,IBUF+1
02400		SKIPGE ROFLG
02500		JRST ROTA-1
02600	PLOT1:	MOVE 14,2(E)
02700		LSHC 14,-10
02800		ASH 15,-34
02900		MOVEM 15,SVPEN#		;GET PEN CODE
03000		MOVM A,15
03100		LSHC 14,-16
03200		ASH 15,-26
03300		MOVEM 15,SVY#		;GET Y
03400		SUB 15,YY
03500		MOVEM 15,SVYSB#		;SAVE Y DIFF
03600		IMULI 15,LBUFL+1
03700		ADD 15,Y
03800		MOVEM 15,SVYOD#		;SAVE NEW Y
03900		CAIGE 15,(L)		;OFF TOP
04000		JRST LOSE
04100		CAIL 15,-LBUFL-1(U)	;OFF BOTTOM
04200		JRST LOSE
04300		LSHC 14,-16
04400		ASH 15,-26
04500		MOVEM 15,SVX#		;GET X
04600		SUB 15,XX
04700		MOVE 0,15		;0 HAS X DIFF
04800		HRRZ 16,X
04900		IMULI 16,44	;TIMES BITS INA WORD
05000		JFFO B,.+1	
05100		ADD 16,C	;PLUS REMAINDER EQ OLD X
05200		SUB 16,15
05300		JUMPL 16,LOSEX
05400		CAILE 16,=1727
05500		JRST LOSEX
05600		SKIPE OOBFLG#		;CK IF ALREADY OOB
05700		JRST OOBAR
05800	FIXUP:	CAIE A,1	;FIXUP WHAT?
05900		HRRM A,PENN
06000		HRR A,PENN	;SAME PEN IF 1
06100		CAIN A,3
06200		JRST PENUP	;PENUP IF 3
06300		MOVE C,SVYSB	;Y DIFF
06400		IORM B,@X	;MARK NOW X Y
06500				;FIND DIRECTION
06600		JUMPE NORMX	;VERT OR NO MOVE
06700		JUMPL MVLFT	;LEFT
06800		JUMPE C,NRT	;HORZ
06900		JUMPL C,MVDWN	;DOWN
07000		CAMLE C,0	;JUMP IF Y DIFF > X DIFF
07100		JRST XCHA
07200	
07300		SETZ 14,	;↓↓ MOVE UP AND RIGHT
07400		TLNE C,200000
07500		JRST .+4
07600		LSH C,1
07700		TRO C,1
07800		AOJA 14,.-4
07900		SUBI 14,=34
08000		IDIV C,0
08100		MOVNS 14
08200		LSH C,(14)
08300		SETZ 15,
08400	INLOOP:	ADD 15,C
08500		TLZE 15,200000
08600		ADDI Y,LBUFL+1
08700		SKIPGE B
08800		SOJ X,
08900		ROT B,1
09000		IORM B,@X
09100		SOJG INLOOP
09200		JRST DONXT
09300	
     

00100	XCHA:	SETZ 14,	;↓↓MOVE UP AND RIGHT
00200		TLNE 0,200000
00300		JRST .+4
00400		LSH 0,1
00500		TRO 0,1
00600		AOJA 14,.-4
00700		SUBI 14,=34
00800		IDIV 0,C
00900		MOVNS 14
01000		LSH 0,(14)
01100		SETZ 15,
01200	INLOO:	ADD 15,0
01300		TLZN 15,200000
01400		JRST MVUP
01500		SKIPGE B
01600		SOJ X,
01700		ROT B,1
01800	MVUP:	ADDI Y,LBUFL+1
01900		IORM B,@X
02000		SOJG C,INLOO
02100		JRST DONXT
02200	
02300	MVDWN:	MOVMS C		;↓↓MOVE DOWN AND RIGHT
02400		CAMLE C,0
02500		JRST XCHA2	;JUMP IF YDIFF > XDIFF
02600		SETZ 14,
02700		TLNE C,200000
02800		JRST .+4
02900		LSH C,1
03000		TRO C,1
03100		AOJA 14,.-4
03200		SUBI 14,=34
03300		IDIV C,0
03400		MOVNS 14
03500		LSH C,(14)
03600		SETZ 15,
03700	INLOP:	ADD 15,C
03800		TLZE 15,200000
03900		SUBI Y,LBUFL+1
04000		SKIPGE B
04100		SOJ X,
04200		ROT B,1
04300		IORM B,@X
04400		SOJG INLOP
04500		JRST DONXT
04600	
04700	XCHA2:	SETZ 14,	;↓↓MOVE DOWN AND RIGHT
04800		TLNE 0,200000
04900		JRST .+4
05000		LSH 0,1
05100		TRO 0,1
05200		AOJA 14,.-4
05300		SUBI 14,=34
05400		IDIV 0,C
05500		MOVNS 14
05600		LSH 0,(14)
05700		SETZ 15,
05800	INOOP:	ADD 15,0
05900		TLZN 15,200000
06000		JRST MVEX
06100		SKIPGE B
06200		SOJ X,
06300		ROT B,1
06400	MVEX:	SUBI Y,LBUFL+1
06500		IORM B,@X
06600		SOJG C,INOOP
06700		JRST DONXT
06800	
06900	NRT:	JUMPL B,GOOP	;HORZ RIGHT
07000	TOOT:	ROT B,1
07100		IORM B,@X
07200		SOJG 0,NRT
07300		JRST DONXT
07400	GOOP:	SOJ X,
07500		CAIGE 0,44
07600		JRST TOOT
07700		IDIVI 0,44
07800		SETOM @X
07900		SOJ X,
08000		SOJG 0,.-2
08100		HRR 0,1
08200		JUMPN 0,TOOT
08300		AOJ X,
08400		JRST DONXT
08500	
08600	NLFT:	MOVMS 0		;HORZ LEFT
08700		ROT B,-1
08800		JUMPL B,ROOT
08900	WOOP:	IORM B,@X
09000		SOJG 0,.-3
09100		JRST DONXT
09200	ROOT:	AOJ X,
09300		CAIGE 0,44
09400		JRST WOOP
09500		IDIVI 0,44
09600		SETOM @X
09700		AOJ X,
09800		SOJG 0,.-2
09900		HRR 0,1
10000		JUMPN 0,WOOP
10100		SOJ X,
10200		ROT B,1
10300		JRST DONXT
10400	NORMX:	JUMPE C,NOMOVE	;NO DIFF
10500		JUMPL C,MDOWN	;MOVE VERT DOWN
10600	MUP:	ADDI Y,LBUFL+1	;MOVE VERT UP
10700		IORM B,@X
10800		SOJG C,MUP
10900		JRST DONXT
11000	MDOWN:	SUBI Y,LBUFL+1	;MOVE VERT DOWN
11100		IORM B,@X
11200		AOJL C,MDOWN
11300	DONXT:	MOVE 4,SVX	;DONE. NOW UPDATE X AND Y
11400		MOVEM 4,XX
11500	NXTY:	MOVE 4,SVY
11600		MOVEM 4,YY
11700	NOMOVE:	SKIPL SVPEN
11800		JRST ENOUT
11900		SETZM XX	;IF NEW LOCO
12000		SETZM YY
12100	ENOUT:	AOBJN E,PLOT1	;GET NEXT
12200		JRST OUTER
12300	
     

00100	MVLFT:	MOVMS 0		;MOVE LEFT THEN RIGHT
00200		MOVMS 15
00300		JUMPE C,NLFT
00400		HRR Y,SVYOD
00500		IDIVI 15,44
00600		ADD X,15
00700	XEND:	SOJL 16,DUN
00800		ROT B,-1
00900		JUMPGE B,XEND
01000		AOJ X,
01100		JRST XEND
01200	DUN:	MOVEM X,XX	;SAVE NEW X POS
01300		MOVEM B,YY
01400		IORM B,@X
01500		JUMPL C,MVLD
01600		CAMLE C,0
01700		JRST XCHA3
01800		SETZ 14,	;MOVE LEFT UP
01900		TLNE C,200000
02000		JRST .+4
02100		LSH C,1
02200		TRO C,1
02300		AOJA 14,.-4
02400		SUBI 14,=34
02500		IDIV C,0
02600		MOVNS 14
02700		LSH C,(14)
02800		SETZ 15,
02900	ILOOP:	ADD 15,C
03000		TLZE 15,200000
03100		SUBI Y,LBUFL+1
03200		SKIPGE B
03300		SOJ X,
03400		ROT B,1
03500		IORM B,@X
03600		SOJG ILOOP
03700		JRST BFOR
03800	
03900	XCHA3:	SETZ 14,
04000		TLNE 0,200000
04100		JRST .+4
04200		LSH 0,1
04300		TRO 0,1
04400		AOJA 14,.-4
04500		SUBI 14,=34
04600		IDIV 0,C
04700		MOVNS 14
04800		LSH 0,(14)
04900		SETZ 15,
05000	ILOP:	ADD 15,0
05100		TLZN 15,200000
05200		JRST DOQ
05300		SKIPGE B
05400		SOJ X,
05500		ROT B,1
05600	DOQ:	SUBI Y,LBUFL+1
05700		IORM B,@X
05800		SOJG C,ILOP
05900		JRST BFOR
06000	
06100	MVLD:	MOVMS C		;MOVE LEFT DOWN
06200		CAMLE C,0
06300		JRST XCHA4
06400		SETZ 14,
06500		TLNE C,200000
06600		JRST .+4
06700		LSH C,1
06800		TRO C,1
06900		AOJA 14,.-4
07000		SUBI 14,=34
07100		IDIV C,0
07200		MOVNS 14
07300		LSH C,(14)
07400		SETZ 15,
07500	LOOP:	ADD 15,C
07600		TLZE 15,200000
07700		ADDI Y,LBUFL+1
07800		SKIPGE B
07900		SOJ X,
08000		ROT B,1
08100		IORM B,@X
08200		SOJG LOOP
08300		JRST BFOR
08400	
08500	XCHA4:	SETZ 14,
08600		TLNE 0,200000
08700		JRST .+4
08800		LSH 0,1
08900		TRO 0,1
09000		AOJA 14,.-4
09100		SUBI 14,=34
09200		IDIV 0,C
09300		MOVNS 14
09400		LSH 0,(14)
09500		SETZ 15,
09600	LOP:	ADD 15,0
09700		TLZN 15,200000
09800		JRST DOP
09900		SKIPGE B
10000		SOJ X,
10100		ROT B,1
10200	DOP:	ADDI Y,LBUFL+1
10300		IORM B,@X
10400		SOJG C,LOP
10500	
10600	BFOR:	HRR Y,SVYOD	;RESTORE PEN TO NEW PEN
10700		MOVE X,XX
10800		MOVE B,YY
10900		JRST DONXT
11000	
     

00100	OOBAR:	SETZM OOBFLG	; GET HERE IF ALL READY OOB
00200		AOSG SSS	; THIS IS FOR THE FIRST OOB FROM MP
00300		JRST FIXUP	;
00400	PENUP:	HRR Y,SVYOD	; PEN IS UP GET NEW Y
00500		JUMPE 15,NXTY	;IF VERT
00600		JUMPL 15,PULFT	;IF LEFT
00700		CAIGE 15,44	;↓↓MOVE UP PEN RIGHT TO NEW X
00800		JRST XLOOP
00900		IDIVI 15,44
01000		SUB X,15
01100		HRR 15,16
01200	XLOOP:	SOJL 15,DONXT
01300		SKIPGE B
01400		SOJ X,
01500		ROT B,1
01600		JRST XLOOP
01700	
01800	PULFT:	MOVMS 15	;↓↓MOVE UP PEN LEFT TO NEW X
01900		CAIGE 15,44
02000		JRST OOO
02100		IDIVI 15,44
02200		ADD X,15
02300		HRR 15,16
02400	OOO:	SOJL 15,DONXT
02500		ROT B,-1
02600		JUMPGE B,OOO
02700		AOJ X,
02800		JRST OOO
02900	
03000	LOSEX:	SETOM OOBFLG	;OOB X
03100		SKIPE POOBX
03200		JRST PENUP
03300		SETOM POOBX
03400		PUSHJ P,DETCHK
03500	 	 PUSHJ P,XERR
03600		PUSHJ P,ERRPNT
03700		ASCIZ /POINT OUT OF BOUNDS, /
03800		JUMPL 16,[PUSHJ P,ERRPNT
03900			  ASCIZ/-X/
04000			  JRST PENUP]
04100		PUSHJ P,ERRPNT
04200		ASCIZ/+X/
04300		JRST PENUP
04400	
04500	LOSE:	SETOM OOBFLG	;OOB Y
04600		SKIPE POOBY
04700		JRST LOBAC
04800		SETOM POOBY
04900		PUSHJ P,DETCHK
05000		PUSHJ P,XERR
05100		PUSHJ P,ERRPNT
05200		ASCIZ /POINT OUT OF BOUNDS, /
05300		CAIGE 15,(L)
05400		JRST [	PUSHJ P,ERRPNT
05500			ASCIZ/-Y/
05600			JRST LOBAC]
05700		PUSHJ P,ERRPNT
05800		ASCIZ/+Y/
05900	LOBAC:	LSHC 14,-16
06000		ASH 15,-26
06100		MOVEM 15,SVX
06200		SUB 15,XX
06300		JRST PENUP
06400	
06500	DECOUT:	IDIVI T,=10	;DEC TTY OUT
06600		HRLM TT,(P)
06700		SKIPE T
06800		PUSHJ P,DECOUT
06900		HLRZ TT,(P)
07000		ADDI TT,60
07100		ROT TT,-7
07200		MOVEM TT,.+2
07300		PUSHJ P,ERRPNT
07400		0
07500		POPJ P,
07600	
07700	ERRPNT:	HRRZ TT,(P)		;ERROR TTY OUT
07800		MOVEM TT,PNTR
07900		MOVEI TT,LINE
08000		TTYMES TT,
08100		JRST [	OUTSTR[ASCIZ/TTYMES FAILED	/]
08200			OUTSTR @PNTR
08300			OUTSTR[ASCIZ/
08400	/]
08500			JRST .+1]
08600		POP P,TT
08700		HRL TT,(TT)
08800		TLNE TT,376
08900		AOJA TT,.-2
09000		JRST 1(TT)
09100	
09200	XERR:	PUSHJ P,ERRPNT		;DET TTY OUT
09300		ASCIZ/
09400	MESSAGE FROM X WORKING ON /
09500		MOVE TT,FILNAM
09600		PUSHJ P,SIXOUT
09700		PUSHJ P,ERRPNT
09800		ASCIZ/./
09900		HLLZ TT,FILEXT
10000		PUSHJ P,SIXOUT
10100		PUSHJ P,ERRPNT
10200		ASCIZ/[/
10300		MOVE TT,FILPPN
10400		PUSHJ P,SIXOUT
10500		PUSHJ P,ERRPNT
10600		ASCIZ/] : /
10700		POPJ P,
10800	
10900	SIXOUT:	JUMPE TT,CPOPJ		;SIXBIT OUT
11000		SETZ T,
11100		LSHC T,6
11200		ADDI T,40
11300		PUSH P,TT
11400		ROT T,-7
11500		MOVEM T,.+2
11600		PUSHJ P,ERRPNT
11700		0
11800		POP P,TT
11900		JRST SIXOUT
12000	
12100	DETCHK:	SETOM DET#	;CK FOR DET JOB
12200		GETLIN DET
12300		HRRES DET
12400		SKIPL DET
12500		AOS (P)
12600		POPJ P,
12700	
     

00100	FINDL:	HRRZ A,JOBREL		;CK IF BIG ENUF
00200		CAIL A,-LBUFL-1(U)
00300		JRST XINL-1
00400	XL2:	MOVEM TT,(T)		;ADD MORE AND MARK
00500		ADDI T,LBUFL+1
00600		CAIGE T,(A)
00700		JRST XL2
00800		SUBI A,(L)
00900		MOVNS A
01000		HRLM A,XGPPTR
01100		SUBI T,LBUFL+1
01200		JRST XXOUT
01300	
01400	PCUT:	HRRZ L,XGPPTR				;MARK BLOCK FOR XGP
01500		MOVE TT,[BYTE (12)4001,LMAR,LBUFL]
01600		MOVEM TT,1(L)		;FIRST ONE HAS MARK AND CUT WITH IT
01700		TLZ TT,400000		;DELETE MARK AND CUT
01800		MOVEI T,1+LBUFL+1(L)
01900		SKIPGE DEFA
02000		JRST FINDL
02100		MOVE B,SVBBB
02200	XINL:	MOVEM TT,(T)
02300		ADDI T,LBUFL+1
02400		SOJG B,XINL
02500		HLRO TT,XGPPTR
02600		MOVNS TT
02700		ADDI TT,(L)
02800		MOVE A,(TT)
02900	XXOUT:	MOVSI TT,400100
03000		MOVEM TT,(T)		;SO DOES LAST
03100	
03200		SKIPN SPREAD
03300		JRST XGPOUT
03400	
03500		HRRZ T,XGPPTR
03600		ADDI T,LBUFL+1
03700		HRRZ C,SVBBB
03800	
03900		SKIPG SPREAD
04000		JRST NINE
04100	
04200	XLINE4:	HRLI T,-LBUFL
04300	
04400	XSHFT4:	MOVE A,2(T)
04500		MOVE B,3(T)
04600		ROTC A,1
04700		ORM A,2(T)
04800		AOBJN T,XSHFT4
04900		AOJ T,
05000		SOJG C,XLINE4
05100	
05200		HRRZ T,XGPPTR
05300		HRRZ B,SVBBB
05400		
05500	YLINE4:	HRLI T,-LBUFL
05600	
05700	YSHFT4:	MOVE A,LBUFL+3(T)
05800		ORM A,2(T)
05900		AOBJN T,YSHFT4
06000		AOJ T,		;Bump past control word.
06100		SOJG B,YLINE4
06200	
06300		JRST XGPOUT
06400	
06500	NINE:	HRLI T,-LBUFL
06600	
06700	XSHFT9:	MOVE A,2(T)
06800		MOVE B,3(T)
06900		ROTC A,1
07000		ORM A,2(T)
07100		ROTC A,1
07200		ORM A,2(T)
07300		AOBJN T,XSHFT9
07400		AOJ T,
07500		SOJG C,NINE
07600	
07700		HRRZ T,XGPPTR
07800		HRRZ B,SVBBB
07900	
08000	YLINE9:	HRLI T,-LBUFL
08100	
08200	YSHFT9:	MOVE A,LBUFL+LBUFL+4(T)
08300		OR A,LBUFL+3(T)
08400		ORM A,2(T)
08500		AOBJN T,YSHFT9
08600		AOJ T,
08700		SOJG B,YLINE9
08800	
08900	XGPOUT:	OPEN XGP,XNIT		;XGP OUTPUT
09000	;;;	PUSHJ P,NOXGP
09100		JRST NOXGP
09200		OUTSTR[ASCIZ/CRANKING XGP
09300	/]
09400		LOCK
09500	OUTIT:	OUT XGP,XGPPTR
09600		JRST OUTOK
09700	DSKERR:	PUSHJ P,DETCHK
09800		PUSHJ P,XERR
09900		PUSHJ P,ERRPNT
10000		ASCIZ /XGP OUTPUT ERROR.
10100	/
10200	OUTOK:	UNLOCK
10300		RELEAS XGP,
10400	XMORE:	PUSHJ P,DETCHK
10500	;;	JRST DODEL			;DELETE AUTOMATICALLY IF DETACHED
10600		JFCL
10700		OUTSTR[ASCIZ/D=DELETE, R=REPEAT, X=EXIT  /]
10800		INCHRW C
10900		CAIE C,15
11000		JRST .+3
11100		INCHRW C
11200		JRST XMORE+2			; WON'T ACCEPT JUST CRLF
11300		OUTSTR[ASCIZ/
11400	/]
11500		CAIE C,"X"
11600		CAIN C,"x"
11700		SKIPA
11800		JRST .+3
11900		PUSHJ P,CORDWN			;REALLY DONE, CORE DOWN
12000		JRST NODEL 
12100		CAIE C,"R"
12200		CAIN C,"r"
12300		JRST XGPOUT
12400		CAIE C,"D"
12500		CAIN C,"d"
12600		SKIPA   			;IF NOT R, X OR D TRY AGAIN.
12700		JRST XMORE+2
12800		PUSHJ P,CORDWN			;REALLY DONE, CORE DOWN
12900	DODEL:	MOVE A,[FILNAM,,LKENT]
13000		BLT A,LKENT+3
13100		INIT DSK,17
13200		'DSK   '
13300		0
13400		JRST [	SKIPGE DET
13500			PUSHJ P,XERR
13600			PUSHJ P,ERRPNT
13700			ASCIZ/COULDN'T GET DISK FOR DELETE!
13800	/
13900			JRST NODEL]
14000		LOOKUP DSK,LKENT
14100		JRST [	SKIPGE DET
14200			PUSHJ P,XERR
14300			PUSHJ P,ERRPNT
14400			ASCIZ/LOOKUP FOR DELETE FAILED!
14500	/
14600			JRST NODEL]
14700		MOVE A,FILPPN
14800		MOVEM A,LKENT+3
14900		SETZM LKENT
15000		RENAME DSK,LKENT
15100		CAIA
15200		JRST NODEL
15300		SKIPGE DET
15400		PUSHJ P,XERR
15500		PUSHJ P,ERRPNT
15600		ASCIZ/RENAME FOR DELETE FAILED!
15700	/
15800	NODEL:	RELEASE DSK,
15900		SKIPGE DET
16000		PUSHJ P,XERR
16100		PUSHJ P,ERRPNT
16200		ASCIZ/ALL DONE!
16300	/
16400		CALLI 12		;LEAVE
16500	
16600	NOXGP:	PUSHJ P,DETCHK
16700		PUSHJ P,XERR
16800		PUSHJ P,ERRPNT
16900	   	ASCIZ /
17000	WAITING FOR XGP /
17100	;ZZ	ASCIZ /
17200	;ZZXGP BUSY, OUTPUT TO DISK? /
17300	;ZZ	INCHRW A
17400	;ZZ	CAIE A,"Y"
17500	;ZZ	CAIN A,"y"
17600	;ZZ	JRST OUTFIL
17700		HRRZI A,1017
17800		HRRZM A,XNIT
17900	;;;	POPJ P,
18000		JRST XGPOUT
18100	
18200	XNIT:	417
18300		'XGP   '
18400		0
18500	XGPPTR:	BLOCK 2
18600	
18700	IFN LSTBIT-1,<
18800	XFIX:	MOVE A,[LSTBIT-1]
18900		HRRZ C,JOBREL
19000		HRRZ D,XGPPTR
19100	XFIXL:	ANDCAM A,LBUFL-1+2(D)
19200		ADDI D,LBUFL+1
19300		CAIGE D,(C)
19400		JRST XFIXL
19500		POPJ P,
19600	>
19700	CORDWN:	MOVE T,JOBFF
19800		SUBI T,1
19900		CALLI T,11
20000		JRST 4,.
20100		POPJ P,
20200	
     

00100	INBITS:	PUSHJ P,NAMGET		;INPUT OLD BIT FILE
00200		HRRZ U,JOBFF
00300		HRRZI T,177(U)
00400		CORE T,
00500		JRST INBITS
00600		SOJ U,
00700		HRLI U,-200
00800		OPEN [17↔'DSK   '↔0]
00900		JRST INBITS
01000		LOOKUP FILNAM
01100		JRST INBITS
01200		SETZ 10,
01300	TRYTRY:	OPEN XGP,XNIT	  ;***** GRAB THE XGP BEFORE CORE EXPANSION
01400		JRST NONO    	 ;CAN'T GET IT!
01500		INPUT U
01600		MOVE T,[BYTE (12)4001,LMAR,LBUFL]
01700		EXCH T,1(U)
01800		HLL U,T
01900		MOVEM U,XGPPTR
02000		HRLI U,(T)
02100		TLNN U,777777
02200		JRST CLOZE
02300		ADDI U,200
02400		MOVNI T,(T)
02500		ADDI T,(U)
02600		CORE T,
02700		JRST INBITS	;HANG
02800		INPUT U
02900	CLOZE:	RELEAS
03000		JRST XGPOUT
03100	
03200	NONO:	OUTSTR[ASCIZ/
03300	WAITING FOR XGP  /]
03400		HRRZI A,1017
03500		HRRZM A,XNIT
03600		JRST TRYTRY
03700	
03800	OUTFIL:	PUSHJ P,NAMGET		;OUTPUT BIT FILE
03900		MOVE U,XGPPTR
04000		HLRO T,U
04100		MOVNS T
04200		TRZ T,177
04300		HRRZI A,200(T)
04400		ADDI A,(U)
04500		CORE A,
04600		JRST OUTFIL
04700		MOVNS T
04800		HLL T,U			;FIRST WD IS WC-200,-WC
04900		MOVEM T,1(U)
05000		HRLI U,-200(T)
05100		SETZ 10,
05200		OPEN [17↔'DSK   '↔0]
05300		JRST 4,.
05400		ENTER FILNAM
05500		CAIA
05600		OUTPUT U
05700		RELEAS
05800		JRST NODEL
05900	
     

00100	;CORUP
00200	
00300	CORUP:
00400	
00500	REPEAT 0,<	OLD WAY - FLUSHED BY REG 1-3-76
00600	
00700		HRRZ B,JOBCNI
00800		CAIE B,20000
00900		DISMIS
01000		MOVE A,JOBTPC
01100		MOVEM A,IPC+1
01200		UWAIT
01300		DEBREAK
01400	>;END REPEAT 0
01500	
01600	BUST:	MOVEM	1,SVONE#
01700	 	MOVEM	2,SVTWO#
01800		MOVEM	TT,SVTTT#
01900		MOVE	1,JOBCNI	;REG  GET APR CONI BITS
02000		TRNN	1,20000		;REG  IS THERE AN MPV?
02100		JRST	NOMPV		;REG  NO
02200		HRRZ	1,JOBREL	;OLD CORE SIZE
02300		MOVSI	2,1(1)		;FIRST NEW WORD WE'LL GET
02400		HRRI	2,2(1)		;SECOND NEW WORD  - 2 HAS A BLT POINTER.
02500		ADDI	1,16000
02600	;;	ADDI	1,10000		;GET ANOTHER 8K
02700		MOVE	TT,1
02800		CORE	1,
02900		PUSHJ	P,CORLUZ
03000		HRRZ	1,JOBREL
03100		SETZM	-1(2)
03200	 	BLT	2,(1)		;ZERO NEW CORE
03300		MOVE	1,SVONE
03400	 	MOVE	2,SVTWO
03500		MOVE	TT,SVTTT
03600	
03700	REPEAT 0,<
03800		INTJEN IPC
03900	>
04000	
04100		JRST	2,@JOBTPC	;REG  THIS IS HOW TO DISMISS OLD INTERRUPT
04200	
04300	NOMPV:	OUTSTR	[ASCIZ/UNEXPECTED INTERRUPT?
04400	/]
04500		JRST	2,@JOBTPC
04600	
04700	CORLUZ:	MOVE T,TT
04800		LSH T,-12
04900		PUSH P,T
05000		PUSHJ P,DETCHK
05100		PUSHJ P,XERR
05200		POP P,T
05300		PUSHJ P,DECOUT
05400		PUSHJ P,ERRPNT
05500		ASCIZ / K OF CORE NEEDED!
05600	/
05700		SKIPGE DET
05800		CALLI 12
05900		JRST ASKLEN
06000	
06100	FNF:	PUSHJ P,DETCHK		;FILE NOT FOUND
06200		PUSHJ P,XERR
06300		PUSHJ P,ERRPNT
06400		ASCIZ /LOOKUP FAILED.
06500	/
06600		SKIPGE DET
06700		CALLI 12
06800		JRST FILIN
06900	
     

00100	;******** TYPE '4' FOR 4X4 DOTS, TYPE '9' FOR 9X9 DOTS.***********
00200	
00300	FRD:	MOVSI A,'PLT'		;FILE SCAN
00400		MOVEM A,FILEXT
00500		SKIPN GO
00600		JRST .+3		;GO?
00700		MOVEI C,12		; CR
00800		JRST .+3
00900		PUSHJ P,GETNAM
01000		CAME A,[SIXBIT/G/]	;G ALONE = 'GO'
01100		JRST GOX
01200		SETOM GO		;GO BACK AND USE DEFAULT NAME.
01300		POPJ P,
01400	
01500	;;GOX:	CAME A,[SIXBIT/:/]	;FOR * FOUR
01600	GOX:	CAME A,[SIXBIT/4/]	;FOR * FOUR
01700		JRST CKSEMI
01800		AOS SPREAD
01900	POPBAC:	POP P,A
02200		CLRBFI
02300		JRST FILIN
02400	CKSEMI:	CAME A,[SIXBIT/9/]		;FOR * NINE
02500	;;CKSEMI:	CAME A,[SIXBIT/;/]
02600		JRST CKDEFA
02700		SETOM SPREAD
02800		JRST POPBAC
02900	CKDEFA:	SKIPN A
03000	 	MOVE A,['PLT   ']
03100	    	MOVEM A,FILNAM
03200		CAIE C,"."
03300		JRST NOEXT
03400		PUSHJ P,GETNAM
03500		MOVEM A,FILEXT
03600	NOEXT:	CAIE C,"["
03700		JRST FRDX
03800		PUSHJ P,GETP
03900		HRLZM A,FILPPN
04000		PUSHJ P,GETP
04100		HRRM A,FILPPN
04200	FRDX:	SKIPN GO
04300		INCHRW C
04400		CAIE C,12
04500		JRST FRDX
04600		POPJ P,
04700	
04800	RNUM:	INCHWL C		;NUM SCAN
04900		CAIN C,15
05000		JRST RNUM
05100		CAIN C,12
05200		POPJ P,
05300		AOS (P)
05400		MOVEI A,
05500		SETZM SIGN
05600		CAIN C,"-"
05700		JRST [	PUSHJ P,RNUML
05800			SETOM SIGN
05900			MOVN A,A
06000			POPJ P,]
06100		CAIN C,"+"
06200	RNUML:	INCHWL C
06300		CAIL C,"0"
06400		CAILE C,"9"
06500		JRST RNUMX
06600		IMULI A,12
06700		ADDI A,-"0"(C)
06800		JRST RNUML
06900	
07000	RNUMX:	CAIN C,15
07100		INCHRW C
07200		POPJ P,
07300	
     

00100	GETNAM:	MOVEI A,		;FILE SCAN
00200		MOVE B,[440600,,A]
00300	GETNML:	PUSHJ P,RCH
00400		POPJ P,
00500		SUBI C,40
00600		TLNE B,770000
00700		IDPB C,B
00800		JRST GETNML
00900	
01000	GETP:	MOVEI A,
01100	GETPL:	PUSHJ P,RCH
01200		POPJ P,
01300		TRNE A,770000
01400		JRST GETPL
01500		LSH A,6
01600		ADDI A,-40(C)
01700		JRST GETPL
01800	
01900	RCH:	INCHWL C
02000		CAIN C,42
02100		JRST RCHQ
02200		CAIE C,11
02300		CAIN C," "
02400		JRST RCH
02500		CAIE C,"."
02600		CAIN C,","
02700		POPJ P,
02800		CAIE C,"["
02900		CAIN C,"]"
03000		POPJ P,
03100	RCHQR:	CAIGE C,40
03200		POPJ P,
03300		CAIL C,"a"
03400		CAILE C,"z"
03500		CAIA
03600		SUBI C,40
03700		JRST POPJ1
03800	
03900	RCHQ:	INCHWL C
04000		JRST RCHQR
04100	
04200	NAMGET:	CLRBFI
04300		OUTSTR [ASCIZ/
04400		FILE = /]
04500		SETZM FILEXT+1
04600		SETZM FILPPN
04700		MOVSI A,'BIT'
04800		MOVEM A,FILEXT
04900		PUSHJ P,GETNAM
05000		SKIPN A
05100	 	MOVE A,['PLT   ']
05200	    	MOVEM A,FILNAM
05300		CAIE C,"."
05400		JRST NOEXTN
05500		PUSHJ P,GETNAM
05600		MOVEM A,FILEXT
05700	NOEXTN:	CAIE C,"["
05800		JRST FFDX
05900		PUSHJ P,GETP
06000		HRLZM A,FILPPN
06100		PUSHJ P,GETP
06200		HRRM A,FILPPN
06300	FFDX:	INCHRW C
06400		CAIE C,12
06500		JRST FFDX
06600		POPJ P,
06700	
     

00100	FILNAM:	0			;GLOPS OF JUNK
00200	FILEXT:	0
00300		0
00400	FILPPN:	0
00500	
00600	LKENT:	BLOCK 4
00700	
00800	XGSNAM:	0
00900	XGSEXT:	0
01000		0
01100	XGSPPN:	0
01200	
01300	IBUF:	BLOCK 3
01400	
01500	BITTAB:	FOR I←43,0,-1{1⊗I
01600	}
01700	BYTTAB:	FOR I←36,0,-6{REPEAT 6,{77⊗I}}
01800	
01900	DBUF:	BLOCK LBUFL+2
02000	
02100	PDL:	BLOCK LPDL
02200	
02300	END BEG